home *** CD-ROM | disk | FTP | other *** search
/ FishMarket 1.0 / FishMarket v1.0.iso / fishies / 076-100 / disk_081 / icon / xref.icn < prev   
Text File  |  1992-05-06  |  5KB  |  195 lines
  1. #    I-XREF(1)
  2. #
  3. #    Icon program cross-reference
  4. #
  5. #    Allan J. Anderson
  6. #
  7. #    Last modified 7/10/83
  8. #
  9.  
  10. global resword, linenum, letters, digits, var, buffer, qflag, f, fflag, xflag
  11. global inmaxcol, inlmarg, inchunk, localvar
  12.  
  13. record procrec(pname,begline,lastline)
  14.  
  15. procedure main(a)
  16.    local word, w2, p, prec, i, L, ln
  17.    initial {
  18.       resword := ["break","by","case","default","do","dynamic","else",
  19.           "end","every","external","fail","global","if",
  20.           "initial","local","next","not","of","procedure",
  21.           "record","repeat","return","static","suspend","then",
  22.           "to","until","while"]
  23.       linenum := 0
  24.       var := table()        # var[variable[proc]] is list of line numbers
  25.       prec := []        # list of procedure records
  26.       localvar := []        # list of local variables of current routine
  27.       buffer := []        # a put-back buffer for getword
  28.       proc := "global"
  29.       letters := 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz' ++ '_'
  30.       digits := '1234567890'
  31.       }
  32. # &trace := -1
  33.    every p := a[i := 1 to *a] do
  34.       if p == ("-q" | "-Q") then
  35.      qflag := 1
  36.       else if p == ("-x" | "-X") then
  37.      xflag := 1
  38.       else if p == ("-w" | "-W") then
  39.      inmaxcol := integer(a[i + 1])
  40.       else if p == ("-l" | "-L") then
  41.      inlmarg := integer(a[i + 1])
  42.       else if p == ("-c" | "-C") then
  43.      inchunk := integer(a[i + 1])
  44.       else if f := open(p,"r") then
  45.      fflag := 1
  46.    while word := getword() do
  47.       if word == "procedure" then {
  48.      put(prec,procrec("",linenum,0))
  49.      proc := getword() | break
  50.      p := pull(prec)
  51.      p.pname := proc
  52.      put(prec,p)
  53.      }
  54.       else if word == ("global" | "external" | "record") then {
  55.      word := getword() | break
  56.      addword(word,"global",linenum)
  57.      while (w2 := getword()) == "," do {
  58.         if Find(word,resword) then break
  59.         word := getword() | break
  60.         addword(word,"global",linenum)
  61.         }
  62.      put(buffer,w2)
  63.      }
  64.       else if word == ("local" | "dynamic" | "static") then {
  65.      word := getword() | break
  66.      put(localvar,word)
  67.      addword(word,proc,linenum)
  68.      while (w2 := getword()) == "," do {
  69.         if Find(word,resword) then break
  70.         word := getword() | break
  71.         put(localvar,word)
  72.         addword(word,proc,linenum)
  73.         }
  74.      put(buffer,w2)
  75.      }
  76.       else if word == "end" then {
  77.      proc := "global"
  78.      localvar := []
  79.      p := pull(prec)
  80.      p.lastline := linenum
  81.      put(prec,p)
  82.      }
  83.       else if Find(word,resword) then 
  84.      next
  85.       else {
  86.      ln := linenum
  87.      if (w2 := getword()) == "(" then
  88.         word ||:= " *"            # special mark for procedures
  89.      else
  90.         put(buffer,w2)            # put back w2
  91.      addword(word,proc,ln)
  92.      }
  93.    every write(!format(var))
  94.    write("\n\nprocedures:\tlines:\n")
  95.    L := []
  96.    every p := !prec do
  97.       put(L,left(p.pname,16," ") || p.begline || "-" || p.lastline)
  98.    every write(!(sort(L)))
  99. end
  100.  
  101. procedure addword(word,proc,lineno)
  102.    if any(letters,word) | \xflag then {
  103.       /var[word] := table()
  104.       if /var[word]["global"] | Find(word,\localvar) then {
  105.      /(var[word])[proc] := [word,proc]
  106.      put((var[word])[proc],lineno)
  107.      }
  108.       else {
  109.      /var[word]["global"] := [word,"global"]
  110.      put((var[word])["global"],lineno)
  111.      }
  112.       }
  113. end
  114.  
  115. procedure getword()
  116.    local j, c
  117.    static lin, i
  118.    repeat {
  119.       if *buffer > 0 then return get(buffer)
  120.       if /lin | i = *lin + 1 then
  121.      if lin := myread() then {
  122.         i := 1
  123.         linenum +:= 1
  124.         }
  125.      else fail
  126.       if i := upto(~(' ' ++ '\t' ++ '\n'),lin,i) then {   # skip white space
  127.      j := i
  128.      if lin[i] == ("'" | '"') then {   # don't xref quoted words
  129.         if /qflag then {
  130.            c := lin[i]
  131.            i +:= 1
  132.            repeat
  133.           if i := upto(c ++ '\\',lin,i) + 1 then
  134.              if lin[i - 1] == c then break
  135.              else i +:= 1
  136.           else {
  137.              i := 1
  138.              linenum +:= 1
  139.              lin := myread() | fail
  140.              }
  141.            }
  142.         else i +:= 1
  143.         }
  144.      else if lin[i] == "#" then {    # don't xref comments; get next line
  145.         i := *lin + 1
  146.         }
  147.      else if i := many(letters ++ digits,lin,i) then
  148.         return lin[j:i]
  149.      else {
  150.         i +:= 1
  151.         return lin[i - 1]
  152.         }
  153.      }
  154.       else
  155.      i := *lin + 1
  156.    }       # repeat
  157. end
  158.  
  159. procedure format(T)
  160.    local V, block, n, L, lin, maxcol, lmargin, chunk, col
  161.    initial {
  162.       maxcol := \inmaxcol | 80
  163.       lmargin := \inlmarg | 40
  164.       chunk := \inchunk | 4
  165.       }
  166.    L := []
  167.    col := lmargin
  168.    every V := !T do
  169.       every block := !V do {
  170.      lin := left(block[1],16," ") || left(block[2],lmargin - 16," ")
  171.      every lin ||:= center(block[3 to *block],chunk," ") do {
  172.         col +:= chunk
  173.         if col >= maxcol - chunk then {
  174.            lin ||:= "\n\t\t\t\t\t"
  175.            col := lmargin
  176.            }
  177.         }
  178.      if col = lmargin then lin := lin[1:-6] # came out exactly even
  179.      put(L,lin)
  180.      col := lmargin
  181.      }
  182.    L := sort(L)
  183.    push(L,"variable\tprocedure\t\tline numbers\n")
  184.    return L
  185. end
  186.  
  187. procedure Find(w,L)
  188.    every if w == L[1 to *L] then return
  189. end
  190.  
  191. procedure myread()
  192.    if \fflag then return read(f) else return read()
  193. end
  194.  
  195.